home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / techjock.arc / WINTTT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-18  |  13.6 KB  |  476 lines
  1. {$S-,R-,V-,D-,T-}
  2. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  3. {         TechnoJocks Turbo Toolkit v4.00            Released: Feb 1, 1988    }
  4. {                                                                             }
  5. {         Module: WinTTT   --   screen saving, cursor and windowing procs     }
  6. {                                                                             }
  7. {                       Copyright R. D. Ainsbury (c) 1986                     }
  8. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  9.  
  10. unit WinTTT;
  11.  
  12. interface
  13.  
  14. uses CRT,FastTTT,DOS;
  15.  
  16. Type
  17.  Direction = (Up, Down, Left, Right);
  18.  
  19. Procedure Attrib(X1,Y1,X2,Y2,F,B:byte);
  20. Procedure SizeCursor(ScanTop,ScanBot:byte);
  21. Procedure FindCursor(var X,Y,ScanTop,ScanBot:byte);
  22. Procedure PosCursor(X,Y: integer);
  23. Procedure Fullcursor;
  24. Procedure HalfCursor;
  25. Procedure OnCursor;
  26. Procedure OffCursor;
  27. Procedure SaveScreen(Page:byte);
  28. Procedure RestoreScreen(Page:byte);
  29. Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  30. Procedure SlideRestoreScreen(Page:byte;Way:Direction);
  31. Procedure DisposeScreen(Page:byte);
  32. Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  33. Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  34. Procedure ScrollUp(X1,Y1,X2,Y2:byte);
  35. Procedure PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  36. Procedure PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  37. Procedure Mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  38. Procedure GrowMkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  39. Procedure Rmwin;
  40. Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  41. Procedure TempMessage(X,Y,F,B:integer;St:string);
  42.  
  43. implementation
  44.  
  45. Const
  46.     Max_Windows = 10;          {Change this constant as necessary}
  47.     Max_Screens = 10;          {Change this constant as necessary}
  48.     WindowCounter : byte = 0;
  49.     ScreenCounter : byte = 0;
  50.     DisplayLines = 25;         {Change this constant as necessary}
  51.     Screen_Size = 4000;        {Change this to 8000 for VGA 50 line Mode}
  52.     MonoAdr =$b000;
  53. Type
  54.     Image = array[1..DisplayLines,1..80] of word;
  55.     ScreenImage = record
  56.                        ScreenSnap: Image;
  57.                        CursorX : byte;
  58.                        CursorY : byte;
  59.                        ScanTop : byte;
  60.                        ScanBot : byte;
  61.                   end;
  62.     ScreenPtr = ^ScreenImage;
  63.     WindowImage = record
  64.                        ScreenPtr: Pointer;             {pointer to screen data}
  65.                        Coord    : array[1..4] of byte; {window coords}
  66.                        CursorX  : byte;                {cursor location}
  67.                        CursorY  : byte;
  68.                        ScanTop  : byte;                {cursor shape}
  69.                        ScanBot  : byte;
  70.                   end;
  71.     WindowPtr = ^WindowImage;
  72.  
  73. Var
  74.     Screen : array[1..Max_Screens] of ScreenPtr;
  75.     Win    : array[1..Max_Windows] of WindowPtr;
  76.  
  77.  
  78. {$L WINTTT}
  79.  
  80. {$F+}
  81.   Procedure Attribute(Col,Row,Attr:byte; Number:Word); external;
  82.   Procedure MoveFromScreen(var Source,Dest;Length:Word); external;
  83.   Procedure MoveToScreen(var Source,Dest; Length:Word); external;
  84. {$F-}
  85.  
  86. Procedure WinTTT_Error(No : byte);
  87. {Display error message and halts program}
  88. var Msg : String;
  89. begin
  90.     Case No of
  91.     1 : Msg := '1) -- Max_Screens exceeded.';
  92.     2 : Msg := '2) -- Screen not previously saved, cannot Restore.';
  93.     3 : Msg := '3) -- Screen not previously saved, cannot Dispose.';
  94.     4 : Msg := '4) -- Max_Windows exceeded.';
  95.     5 : Msg := '5) -- Insufficient memory to create window.';
  96.     else Msg := '?) -- Utterly confused';
  97.     end; {Case}
  98.     Msg := 'Fatal Error (WinTTT No. '+Msg;
  99.     Writeln(Msg);
  100.     Delay(5000);    {display long enough to read if child process}
  101.     Halt;
  102. end;
  103.  
  104. Procedure Attrib(X1,Y1,X2,Y2,F,B:byte);
  105. {changes color attrib at specified coords}
  106. var
  107.   I,X,A : byte;
  108. begin
  109.     A := Attr(F,B);
  110.     X := Succ(X2-X1);
  111.     For I := Y1 to Y2 do
  112.         Attribute(X1,I,A,X);
  113. end; {Proc Attrib}
  114.  
  115. Procedure FindCursor(var X,Y,ScanTop,ScanBot:byte);
  116. var
  117.    Reg : registers;
  118. begin
  119.   Reg.Ax := $0F00;              {get page in Bx}
  120.   Intr($10,Reg);
  121.   Reg.Ax := $0300;
  122.   Intr($10,Reg);
  123.   With Reg do
  124.   begin
  125.     X := lo(Dx) + 1;
  126.     Y := hi(Dx) + 1;
  127.     ScanTop := Hi(Cx) and $0F;
  128.     ScanBot := Lo(Cx) and $0F;
  129.   end;
  130. end;
  131.  
  132. Procedure PosCursor(X,Y: integer);
  133. var Reg : registers;
  134. begin
  135.   Reg.Ax := $0F00;              {get page in Bx}
  136.   Intr($10,Reg);
  137.   with Reg do
  138.   begin
  139.     Ax := $0200;
  140.     Dx := ((Y-1) shl 8) or ((X-1) and $00FF);
  141.   end;
  142.   Intr($10,Reg);
  143. end;
  144.  
  145. Procedure SizeCursor(ScanTop,ScanBot:byte);
  146. var Reg : registers;
  147. begin
  148.     with Reg do
  149.     begin
  150.       ax := 1 shl 8;
  151.       cx := Scantop shl 8 + Scanbot;
  152.       INTR($10,Reg);
  153.     end;
  154. end;
  155.  
  156. Procedure HalfCursor;
  157. begin
  158.     If BaseOfScreen = MonoAdr then
  159.        SizeCursor(9,14)
  160.     else
  161.        SizeCursor(5,7);
  162. end; {Proc HalfCursor}
  163.  
  164. Procedure Fullcursor;
  165. begin
  166.     If BaseOfScreen = MonoAdr then
  167.        SizeCursor(0,14)
  168.     else
  169.        SizeCursor(0,7);
  170. end;
  171.  
  172. Procedure OnCursor;
  173. begin
  174.     If BaseOfScreen = MonoAdr then
  175.        SizeCursor(13,14)
  176.     else
  177.        SizeCursor(6,7);
  178. end;
  179.  
  180. Procedure OffCursor;
  181. begin
  182.     Sizecursor(14,0);
  183. end;
  184.  
  185.  
  186. Procedure FillScreen(X1,Y1,X2,Y2:byte; F,B:byte; C:char);
  187. var
  188.    I : integer;
  189.    S : string;
  190. begin
  191.     Attrib(X1,Y1,X2,Y2,F,B);
  192.     S := Replicate(Succ(X2-x1),C);
  193.     For I := Y1 to Y2 do
  194.         PlainWrite(X1,I,S);
  195. end;
  196.  
  197. {
  198. ****************************
  199. * Screen Saving Procedures *
  200. ****************************
  201. }
  202. Procedure Initialize_Screens;
  203. {set Pointers to nil for validity check in RestoreScreen}
  204. Var I : integer;
  205. begin
  206.  For I := 1 to Max_Screens do
  207.   Screen[I] := nil;
  208. end;
  209.  
  210. Procedure PartSave (X1,Y1,X2,Y2:byte; VAR Dest);
  211. {transfers data from video display to Dest}
  212. var
  213.    I,width : byte;
  214.    ScreenAdr: integer;
  215. begin
  216.     width := succ(X2- X1);
  217.     For I :=  Y1 to Y2 do
  218.     begin
  219.      SCreenAdr := Pred(I)*160 + Pred(X1)*2;
  220.      MoveFromScreen(Mem[BaseOfScreen:ScreenAdr],
  221.                     Mem[seg(Dest):ofs(dest)+(I-Y1)*width*2],
  222.                     width);
  223.     end;
  224. end;
  225.  
  226. Procedure PartRestore (X1,Y1,X2,Y2:byte; VAR Source);
  227. {restores data from Source and transfers to video display}
  228. var
  229.    I,width : byte;
  230.    ScreenAdr: integer;
  231. begin
  232.     width := succ(X2- X1);
  233.     For I :=  Y1 to Y2 do
  234.     begin
  235.      ScreenAdr := Pred(I)*160 + Pred(X1)*2;
  236.      MoveToScreen(Mem[Seg(Source):ofs(Source)+(I-Y1)*width*2],
  237.                   Mem[BaseOfScreen:ScreenAdr],
  238.                   width);
  239.     end;
  240. end;
  241.  
  242. Procedure SaveScreen(Page:byte);
  243. {Save screen display and cursor details}
  244. begin
  245.     If (Page > Max_Screens) then
  246.       WinTTT_Error(1);
  247.     If MaxAvail < Screen_Size then
  248.        WinTTT_Error(6);
  249.     GetMem(Screen[Page],Screen_Size);
  250.     MoveFromScreen(Mem[BaseOfScreen:0],Screen[Page]^.ScreenSnap, Screen_Size div 2);
  251.     FindCursor(Screen[Page]^.CursorX,         {Save Cursor posn. and shape}
  252.                Screen[Page]^.CursorY,
  253.                Screen[Page]^.ScanTop,
  254.                Screen[Page]^.ScanBot);
  255. end;
  256.  
  257. Procedure RestoreScreen(Page:byte);
  258. {Display a screen that was previously saved}
  259. begin
  260.     If Screen[Page] = nil then
  261.        WinTTT_Error(2);
  262.         MoveToScreen(Screen[Page]^.ScreenSnap,mem[BaseOfScreen:0], Screen_Size div 2);
  263.     PosCursor(Screen[Page]^.CursorX,Screen[Page]^.CursorY);
  264.     SizeCursor(Screen[Page]^.ScanTop,Screen[Page]^.ScanBot);
  265. end;  {Proc RestoreScreen}
  266.  
  267.  
  268. Procedure PartRestoreScreen(Page,X1,Y1,X2,Y2,X,Y:byte);
  269. {Move from heap to screen, part of saved screen}
  270. Var
  271.    I,width     : byte;
  272.    ScreenAdr,
  273.    PageAdr     : integer;
  274. begin
  275.     If Screen[Page] = nil then
  276.        WinTTT_Error(2);
  277.     Width := succ(X2- X1);
  278.     For I :=  Y1 to Y2 do
  279.     begin
  280.         ScreenAdr := pred(Y+I-Y1)*160 + Pred(X)*2;
  281.         PageAdr   := Pred(I)*160 + Pred(X1)*2;
  282.         MoveToScreen(Mem[Seg(Screen[Page]^):ofs(Screen[Page]^)+PageAdr],
  283.                      Mem[BaseOfScreen:ScreenAdr],
  284.                      width);
  285.     end;
  286. end;
  287.  
  288. Procedure SlideRestoreScreen(Page:byte;Way:Direction);
  289. {Display a screen that was previously saved, with fancy slide}
  290. Var I : byte;
  291. begin
  292.     If Screen[Page] = nil then
  293.        WinTTT_Error(2);
  294.     Case Way of
  295.     Up    : begin
  296.                 For I := DisplayLines downto 1 do
  297.                 begin
  298.                     PartRestoreScreen(Page,
  299.                                       1,1,80,succ(DisplayLines -I),
  300.                                       1,I);
  301.                     Delay(50);
  302.                 end;
  303.             end;
  304.     Down  : begin
  305.                 For I := 1 to DisplayLines do
  306.                 begin
  307.                     PartRestoreScreen(Page,
  308.                                       1,succ(DisplayLines -I),80,DisplayLines,
  309.                                       1,1);
  310.                     Delay(50);  {savor the moment!}
  311.                 end;
  312.             end;
  313.     Left  : begin
  314.                 For I := 1 to 80 do
  315.                 begin
  316.                     PartRestoreScreen(Page,
  317.                                       1,1,I,DisplayLines,
  318.                                       succ(80-I),1);
  319.                 end;
  320.             end;
  321.     Right : begin
  322.                 For I := 80 downto 1 do
  323.                 begin
  324.                     PartRestoreScreen(Page,
  325.                                       I,1,80,DisplayLines,
  326.                                       1,1);
  327.                 end;
  328.             end;
  329.     end; {case}
  330.     PosCursor(Screen[Page]^.CursorX,Screen[Page]^.CursorY);
  331.     SizeCursor(Screen[Page]^.ScanTop,Screen[Page]^.ScanBot);
  332. end;   {Proc SlideRestoreScreen}
  333.  
  334. Procedure DisposeScreen(Page:byte);
  335. {Free memory that was allocated by SvaeScreen}
  336. begin
  337.     If Screen[Page] = nil then
  338.        WinTTT_Error(3);
  339.     FreeMem(Screen[Page],Screen_Size);
  340. end;
  341.  
  342. Procedure CopyScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  343. {copies text and attributes from one part of screen to another}
  344. Var
  345.    I,width     : byte;
  346.    SourceAdr,
  347.    TargetAdr   : integer;
  348.    TempLine    : array[1..160] of byte;
  349. begin
  350.     Width := succ(X2- X1);
  351.     For I :=  Y1 to Y2 do
  352.     begin
  353.         SourceAdr := Pred(I)*160 + Pred(X1)*2;
  354.         TargetAdr := Pred(Y+I-Y1)*160 + Pred(X)*2;
  355.         MoveFromScreen(Mem[BaseOfScreen:SourceAdr],
  356.                        TempLine,
  357.                        width);
  358.         MoveToScreen(TempLine,
  359.                      Mem[BaseOfScreen:TargetAdr],
  360.                      width);
  361.     end;
  362. end; {CopyScreenBlock}
  363.  
  364. Procedure MoveScreenBlock(X1,Y1,X2,Y2,X,Y:byte);
  365. {Moves text and attributes from one part of screen to another,
  366.  replacing with Replace_Char}
  367. const
  368.   Replace_Char = ' ';
  369. Var
  370.    I,width     : byte;
  371.    SourceAdr,
  372.    TargetAdr   : integer;
  373.    TempLine    : array[1..160] of byte;
  374. begin
  375.     Width := succ(X2- X1);
  376.     For I :=  Y1 to Y2 do
  377.     begin
  378.         SourceAdr := Pred(I)*160 + Pred(X1)*2;
  379.         TargetAdr := Pred(Y+I-Y1)*160 + Pred(X)*2;
  380.         MoveFromScreen(Mem[BaseOfScreen:SourceAdr],
  381.                        TempLine,
  382.                        width);
  383.         PlainWrite(X1,I,replicate(succ(X2-X1),Replace_Char));
  384.         MoveToScreen(TempLine,
  385.                      Mem[BaseOfScreen:TargetAdr],
  386.                      width);
  387.     end;
  388. end; {Proc MoveScreenBlock}
  389.  
  390. Procedure ScrollUp(X1,Y1,X2,Y2:byte);
  391. {used for screen scrolling, uses Copy & Plainwrite rather than Move for speed}
  392. const
  393.   Replace_Char = ' ';
  394. begin
  395.   CopyScreenBlock(X1,succ(Y1),X2,Y2,X1,Y1);
  396.   PlainWrite(X1,Y2,replicate(succ(X2-X1),Replace_Char));
  397. end;
  398.  
  399. {
  400. ****************************
  401. *   Windowing Procedures   *
  402. ****************************
  403. }
  404. procedure CreateWin(x1,y1,x2,y2,F,B,boxtype:integer);
  405. {called by MkWin and GrowMkWin}
  406. begin
  407.     If WindowCounter >= Max_Windows then
  408.        WinTTT_Error(4);
  409.     WindowCounter :=  WindowCounter + 1;
  410.     If MaxAvail < sizeOf(Win[WindowCounter]^) then
  411.        WinTTT_Error(5);
  412.     GetMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));    {allocate space}
  413.     If MaxAvail < succ(Y2-Y1)*succ(X2-X1)*2 then
  414.        WinTTT_Error(5);
  415.     GetMem(Win[WindowCounter]^.ScreenPtr,succ(Y2-Y1)*succ(X2-X1)*2);
  416.     PartSave(X1,Y1,X2,Y2,Win[WindowCounter]^.ScreenPtr^);
  417.     with Win[WindowCounter]^ do
  418.     begin
  419.       Coord[1] := X1;
  420.       Coord[2] := Y1;
  421.       Coord[3] := X2;
  422.       Coord[4] := Y2;
  423.       FindCursor(CursorX,CursorY,ScanTop,ScanBot);
  424.     end;  {with}
  425. end; {Proc CreateWin}
  426.  
  427. procedure mkwin(x1,y1,x2,y2,F,B,boxtype:integer);
  428. {Main procedure for creating window}
  429. begin
  430.     CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
  431.     FBox(x1,y1,x2,y2,F,B,boxtype);
  432. end;
  433.  
  434. procedure GrowMKwin(x1,y1,x2,y2,F,B,boxtype:integer);
  435. {same as MKwin but window explodes}
  436. begin
  437.     CreateWin(X1,Y1,X2,Y2,F,B,Boxtype);
  438.     GrowFBox(x1,y1,x2,y2,F,B,boxtype);
  439. end;
  440.  
  441. Procedure RmWin;
  442. begin
  443.     If WindowCounter > 0 then
  444.     begin
  445.         with  Win[WindowCounter]^ do
  446.         begin
  447.             PartRestore(Coord[1],Coord[2],Coord[3],Coord[4],ScreenPtr^);
  448.             PosCursor(CursorX,CursorY);
  449.             SizeCursor(ScanTop,ScanBot);
  450.             FreeMem(ScreenPtr,succ(Coord[4]-coord[2])*succ(coord[3]-coord[1])*2);
  451.             FreeMem(Win[WindowCounter],sizeof(Win[WindowCounter]^));
  452.         end; {with}
  453.         WindowCounter := WindowCounter - 1;
  454.     end;
  455. end;
  456.  
  457. procedure TempMessage(X,Y,F,B:integer;St:string);
  458. var
  459.  CX,CY,CT,CB,I,locC:integer;
  460.  SavedLine : array[1..160] of byte;
  461.  Ch :char;
  462. begin
  463.     PartSave(X,Y,1,length(St),SavedLine);
  464.     {FindCursor(CX,CY,CT,CB);}
  465.     WriteAT(X,Y,F,B,St);
  466.     Ch := ReadKey;
  467.     PartRestore(X,Y,X,Y+length(St),SavedLine);
  468.     {
  469.     SizeCursor(CT,CB);
  470.     PosCursor(CX,CY);
  471.     }
  472. end;
  473.  
  474. begin
  475.     Initialize_Screens;
  476. end.